home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group93c.txt / 000028_icon-group-sender _Tue Jul 27 19:05:26 1993.msg < prev    next >
Internet Message Format  |  1994-02-02  |  32KB
  1. Received: by cheltenham.cs.arizona.edu; Wed, 28 Jul 1993 12:51:58 MST
  2. Date: 27 Jul 93 19:05:26 GMT
  3. From: agate!spool.mu.edu!uwm.edu!linac!uchinews!ellis!goer@ucbvax.Berkeley.EDU  (Richard L. Goerwitz)
  4. Organization: University of Chicago
  5. Subject: flushing files; tokenizing
  6. Message-Id: <1993Jul27.190526.27013@midway.uchicago.edu>
  7. References: <1993Jul27.175905.28820@Princeton.EDU>
  8. Sender: icon-group-request@cs.arizona.edu
  9. To: icon-group@cs.arizona.edu
  10. Status: R
  11. Errors-To: icon-group-errors@cs.arizona.edu
  12.  
  13. Re flushing files:  As of 8.8 or 8.10 you can flush files in Icon.
  14. There's a new built-in function to do it called, as you'd expect,
  15. flush().  Apparently you weren't the only one who felt this need.
  16.  
  17. On another subject, here's another version of the Icon tokenizing
  18. procedure I posted a while back.  This one has a few bugs fixed,
  19. and has a few more options.  I'm posting this now in toto, but I
  20. may post diffs from here on, depending on how great the changes
  21. are.
  22.  
  23. -Richard
  24.  
  25. ############################################################################
  26. #
  27. #    Name:     itokens.icn
  28. #
  29. #    Title:     itokens (Icon source-file tokenizer)
  30. #
  31. #    Author:     Richard L. Goerwitz
  32. #
  33. #    Version: 1.11
  34. #
  35. ############################################################################
  36. #
  37. #  This file contains itokens() - a utility for breaking Icon source
  38. #  files up into individual tokens.  This is the sort of routine one
  39. #  needs to have around when implementing things like pretty printers,
  40. #  preprocessors, code obfuscators, etc.  It would also be useful for
  41. #  implementing cut-down implementations of Icon written in Icon - the
  42. #  sort of thing one might use in an interactive tutorial.
  43. #
  44. #  Itokens(f, x) takes, as its first argument, f, an open file, and
  45. #  suspends successive TOK records.  TOK records contain two fields.
  46. #  The first field, sym, contains a string that represents the name of
  47. #  the next token (e.g. "CSET", "STRING", etc.).  The second field,
  48. #  str, gives that token's literal value.  E.g. the TOK for a literal
  49. #  semicolon is TOK("SEMICOL", ";").  For a mandatory newline, itokens
  50. #  would suspend TOK("SEMICOL", "\n").
  51. #
  52. #  Unlike Icon's own tokenizer, itokens() does not return an EOFX
  53. #  token on end-of-file, but rather simply fails.  It also can be
  54. #  instructed to return syntactically meaningless newlines by passing
  55. #  it a nonnull second argument (e.g. itokens(infile, 1)).  These
  56. #  meaningless newlines are returned as TOK records with a null sym
  57. #  field (i.e. TOK(&null, "\n")).
  58. #
  59. #  NOTE WELL: If new reserved words or operators are added to a given
  60. #  implementation, the tables below will have to be altered.  Note
  61. #  also that &keywords should be implemented on the syntactic level -
  62. #  not on the lexical one.  As a result, a keyword like &features will
  63. #  be suspended as TOK("CONJUNC", "&") and TOK("IDENT", "features").
  64. #
  65. ############################################################################
  66. #
  67. #  Links: slshupto
  68. #
  69. #  Requires: coexpressions
  70. #
  71. ############################################################################
  72.  
  73. #link ximage, slshupto
  74. link slshupto #make sure you have version 1.2 or above
  75.  
  76. global next_c, line_number
  77. record TOK(sym, str)
  78.  
  79. #
  80. # main:  an Icon source code uglifier
  81. #
  82. #     Stub main for testing; uncomment & compile.  The resulting
  83. #     executable will act as an Icon file compressor, taking the
  84. #     standard input and outputting Icon code stripped of all
  85. #     unnecessary whitespace.  Guaranteed to make the code a visual
  86. #     mess :-).
  87. #
  88. #procedure main()
  89. #
  90. #    local separator, T
  91. #    separator := ""
  92. #    every T := itokens(&input) do {
  93. #    if any(&digits ++ &letters ++ '_.', \T.str, 1, 2) & \T.sym ~== "DOT"
  94. #    then writes(separator)
  95. #    if T.sym == "SEMICOL" then writes(";") else writes(T.str)
  96. #    if any(&digits ++ &letters ++ '_.', \T.str, -1, 0) & \T.sym ~== "DOT"
  97. #    then separator := " " else separator := ""
  98. #    }
  99. #
  100. #end
  101.  
  102.  
  103. #
  104. # itokens:  file x anything    -> TOK records (a generator)
  105. #           (stream, nostrip)  -> Rs
  106. #
  107. #     Where stream is an open file, anything is any object (it only
  108. #     matters whether it is null or not), and Rs are TOK records.
  109. #     Note that itokens strips out useless newlines.  If the second
  110. #     argument is nonnull, itokens does not strip out superfluous
  111. #     newlines.  It may be useful to keep them when the original line
  112. #     structure of the input file must be maintained.
  113. #
  114. procedure itokens(stream, nostrip)
  115.  
  116.     local T, last_token
  117.  
  118.     # initialize to some meaningless value
  119.     last_token := TOK()
  120.  
  121.     every T := \iparse_tokens(stream) do {
  122.     if \T.sym then {
  123.         if T.sym == "EOFX" then fail
  124.         else {
  125.         #
  126.         # If the last token was a semicolon, then interpret
  127.         # all ambiguously unary/binary sequences like "**" as
  128.         # beginners (** could be two unary stars or the [c]set
  129.         # intersection operator).
  130.         #
  131.         if \last_token.sym == "SEMICOL"
  132.         then suspend last_token := expand_fake_beginner(T)
  133.         else suspend last_token := T
  134.         }
  135.     } else {
  136.         if \nostrip
  137.         then suspend last_token := T
  138.     }
  139.     }
  140.  
  141. end
  142.  
  143.  
  144. #
  145. # expand_fake_beginner: TOK record -> TOK records
  146. #
  147. #     Some "beginner" tokens aren't really beginners.  They are token
  148. #     sequences that could be either a single binary operator or a
  149. #     series of unary operators.  The tokenizer's job is just to snap
  150. #     up as many characters as could logically constitute an operator.
  151. #     Here is where we decide whether to break the sequence up into
  152. #     more than one op or not.
  153. #
  154. procedure expand_fake_beginner(next_token)
  155.  
  156.     static exptbl
  157.     initial {
  158.     exptbl := table()
  159.     insert(exptbl, "CONCAT",  [TOK("BAR", "|"),   TOK("BAR", "|")])
  160.     insert(exptbl, "DIFF",    [TOK("MINUS", "-"), TOK("MINUS", "-")])
  161.      insert(exptbl, "EQUIV",   [TOK("NUMEQ", "="), TOK("NUMEQ", "="),
  162.                    TOK("NUMEQ", "=")])
  163.     insert(exptbl, "INTER",   [TOK("STAR", "*"),  TOK("STAR", "*")])
  164.     insert(exptbl, "LCONCAT", [TOK("BAR", "|"),   TOK("BAR", "|"),
  165.                    TOK("BAR", "|")])
  166.     insert(exptbl, "LEXEQ",   [TOK("NUMEQ", "="), TOK("NUMEQ", "=")])
  167.     insert(exptbl, "LEXNE",   [TOK("TILDE", "~"), TOK("NUMEQ", "="),
  168.                    TOK("NUMEQ", "=")])
  169.     insert(exptbl, "NOTEQUIV",[TOK("TILDE", "~"), TOK("NUMEQ","="),
  170.                    TOK("NUMEQ", "="), TOK("NUMEQ", "=")])
  171.     insert(exptbl, "NUMNE",   [TOK("TILDE", "~"), TOK("NUMEQ","=")])
  172.     insert(exptbl, "UNION",   [TOK("PLUS", "+"),  TOK("PLUS", "+")])
  173.     }
  174.  
  175.     if \exptbl[next_token.sym]
  176.     then suspend !exptbl[next_token.sym]
  177.     else return next_token
  178.  
  179. end
  180.  
  181.  
  182. #
  183. # iparse_tokens:  file     -> TOK records (a generator)
  184. #                 (stream) -> tokens
  185. #
  186. #     Where file is an open input stream, and tokens are TOK records
  187. #     holding both the token type and actual token text.
  188. #
  189. #     TOK records contain two parts, a preterminal symbol (the first
  190. #     "sym" field), and the actual text of the token ("str").  The
  191. #     parser only pays attention to the sym field, although the
  192. #     strings themselves get pushed onto the value stack.
  193. #
  194. #     Note the following kludge:  Unlike real Icon tokenizers, this
  195. #     procedure returns syntactially meaningless newlines as TOK
  196. #     records with a null sym field.  Normally they would be ignored.
  197. #     I wanted to return them so they could be printed on the output
  198. #     stream, thus preserving the line structure of the original
  199. #     file, and making later diagnostic messages more usable.
  200. #
  201. procedure iparse_tokens(stream, getchar)
  202.  
  203.     local elem, whitespace, token, last_token, primitives, reserveds
  204.     static be_tbl, reserved_tbl, operators
  205.     initial {
  206.  
  207.     #  Primitive Tokens
  208.     #
  209.     primitives := [
  210.                ["identifier",      "IDENT",     "be"],
  211.                ["integer-literal", "INTLIT",    "be"],
  212.                ["real-literal",    "REALLIT",   "be"],
  213.                ["string-literal",  "STRINGLIT", "be"],
  214.                ["cset-literal",    "CSETLIT",   "be"],
  215.                ["end-of-file",     "EOFX",      "" ]]
  216.  
  217.     # Reserved Words
  218.     #
  219.     reserveds  := [
  220.                ["break",           "BREAK",     "be"],
  221.                ["by",              "BY",        ""  ],
  222.                ["case",            "CASE",      "b" ],
  223.                ["create",          "CREATE",    "b" ],
  224.                ["default",         "DEFAULT",   "b" ],
  225.                ["do",              "DO",        ""  ],
  226.                        ["else",            "ELSE",      ""  ],
  227.                ["end",             "END",       "b" ],
  228.                ["every",           "EVERY",     "b" ],
  229.                ["fail",            "FAIL",      "be"],
  230.                ["global",          "GLOBAL",    ""  ],
  231.                ["if",              "IF",        "b" ],
  232.                ["initial",         "INITIAL",   "b" ],
  233.                ["invocable",       "INVOCABLE", ""  ],
  234.                ["link",            "LINK",      ""  ],
  235.                ["local",           "LOCAL",     "b" ],
  236.                ["next",            "NEXT",      "be"],
  237.                ["not",             "NOT",       "b" ],
  238.                ["of",              "OF",        ""  ],
  239.                ["procedure",       "PROCEDURE", ""  ],
  240.                ["record",          "RECORD",    ""  ],
  241.                ["repeat",          "REPEAT",    "b" ],
  242.                ["return",          "RETURN",    "be"],
  243.                ["static",          "STATIC",    "b" ],
  244.                ["suspend",         "SUSPEND",   "be"],
  245.                ["then",            "THEN",      ""  ],
  246.                ["to",              "TO",        ""  ],
  247.                ["until",           "UNTIL",     "b" ],
  248.                ["while",           "WHILE",     "b" ]]
  249.  
  250.     # Operators
  251.     #
  252.     operators  := [
  253.                [":=",              "ASSIGN",    ""  ],
  254.                ["@",               "AT",        "b" ],
  255.                ["@:=",             "AUGACT",    ""  ],
  256.                ["&:=",             "AUGAND",    ""  ],
  257.                ["=:=",             "AUGEQ",     ""  ],
  258.                ["===:=",           "AUGEQV",    ""  ],
  259.                [">=:=",            "AUGGE",     ""  ],
  260.                [">:=",             "AUGGT",     ""  ],
  261.                ["<=:=",            "AUGLE",     ""  ],
  262.                ["<:=",             "AUGLT",     ""  ],
  263.                ["~=:=",            "AUGNE",     ""  ],
  264.                ["~===:=",          "AUGNEQV",   ""  ],
  265.                ["==:=",            "AUGSEQ",    ""  ],
  266.                [">>=:=",           "AUGSGE",    ""  ],
  267.                [">>:=",            "AUGSGT",    ""  ],
  268.                ["<<=:=",           "AUGSLE",    ""  ],
  269.                ["<<:=",            "AUGSLT",    ""  ],
  270.                ["~==:=",           "AUGSNE",    ""  ],
  271.                ["\\",              "BACKSLASH", "b" ],
  272.                ["!",               "BANG",      "b" ],
  273.                ["|",               "BAR",       "b" ],
  274.                ["^",               "CARET",     "b" ],
  275.                ["^:=",             "CARETASGN", "b" ],
  276.                [":",               "COLON",     ""  ],
  277.                [",",               "COMMA",     ""  ],
  278.                ["||",              "CONCAT",    "b" ],
  279.                        ["||:=",            "CONCATASGN",""  ],
  280.                ["&",               "CONJUNC",   "b" ],
  281.                [".",               "DOT",       "b" ],
  282.                ["--",              "DIFF",      "b" ],
  283.                ["--:=",            "DIFFASGN",  ""  ],
  284.                ["===",             "EQUIV",     "b" ],
  285.                ["**",              "INTER",     "b" ],
  286.                ["**:=",            "INTERASGN", ""  ],
  287.                ["{",               "LBRACE",    "b" ],
  288.                ["[",               "LBRACK",    "b" ],
  289.                ["|||",             "LCONCAT",   "b" ],
  290.                ["|||:=",           "LCONCATASGN","" ],
  291.                ["==",              "LEXEQ",     "b" ],
  292.                [">>=",             "LEXGE",     ""  ],
  293.                [">>",              "LEXGT",     ""  ],
  294.                ["<<=",             "LEXLE",     ""  ],
  295.                ["<<",              "LEXLT",     ""  ],
  296.                ["~==",             "LEXNE",     "b" ],
  297.                ["(",               "LPAREN",    "b" ],
  298.                ["-:",              "MCOLON",    ""  ],
  299.                ["-",               "MINUS",     "b" ],
  300.                ["-:=",             "MINUSASGN", ""  ],
  301.                ["%",               "MOD",       ""  ],
  302.                ["%:=",             "MODASGN",   ""  ],
  303.                ["~===",            "NOTEQUIV",  "b" ],
  304.                ["=",               "NUMEQ",     "b" ],
  305.                [">=",              "NUMGE",     ""  ],
  306.                [">",               "NUMGT",     ""  ],
  307.                ["<=",              "NUMLE",     ""  ],
  308.                ["<",               "NUMLT",     ""  ],
  309.                ["~=",              "NUMNE",     "b" ],
  310.                ["+:",              "PCOLON",    ""  ],
  311.                ["+",               "PLUS",      "b" ],
  312.                ["+:=",             "PLUSASGN",  ""  ],
  313.                ["?",               "QMARK",     "b" ],
  314.                ["<-",              "REVASSIGN", ""  ],
  315.                ["<->",             "REVSWAP",   ""  ],
  316.                ["}",               "RBRACE",    "e" ],
  317.                ["]",               "RBRACK",    "e" ],
  318.                [")",               "RPAREN",    "e" ],
  319.                [";",               "SEMICOL",   ""  ],
  320.                ["?:=",             "SCANASGN",  ""  ],
  321.                ["/",               "SLASH",     "b" ],
  322.                ["/:=",             "SLASHASGN", ""  ],
  323.                ["*",               "STAR",      "b" ],
  324.                ["*:=",             "STARASGN",  ""  ],
  325.                [":=:",             "SWAP",      ""  ],
  326.                ["~",               "TILDE",     "b" ],
  327.                ["++",              "UNION",     "b" ],
  328.                ["++:=",            "UNIONASGN", ""  ],
  329.                ["$(",              "LBRACE",    "b" ],
  330.                ["$)",              "RBRACE",    "e" ],
  331.                ["$<",              "LBRACK",    "b" ],
  332.                ["$>",              "RBRACK",    "e" ],
  333.                ["$",               "RHSARG",    "b" ],
  334.                ["%$(",             "BEGGLOB",   "b" ],
  335.                ["%$)",             "ENDGLOB",   "e" ],
  336.                ["%{",              "BEGGLOB",   "b" ],
  337.                ["%}",              "ENDGLOB",   "e" ],
  338.                ["%%",              "NEWSECT",   "be"]]
  339.  
  340.     # static be_tbl, reserved_tbl
  341.     reserved_tbl := table()
  342.     every elem := !reserveds do
  343.         insert(reserved_tbl, elem[1], elem[2])
  344.     be_tbl := table()
  345.     every elem := !primitives | !reserveds | !operators do {
  346.         insert(be_tbl, elem[2], elem[3])
  347.     }
  348.     }
  349.  
  350.     /getchar   := create {
  351.     line_number := 0
  352.     ! ( 1(!stream, line_number +:=1) || "\n" )
  353.     }
  354.     whitespace := ' \t'
  355.     /next_c    := @getchar | {
  356.     if \stream then
  357.         return TOK("EOFX")
  358.     else fail
  359.     }
  360.  
  361.     repeat {
  362.     case next_c of {
  363.  
  364.         "."      : {
  365.         # Could be a real literal *or* a dot operator.  Check
  366.         # following character to see if it's a digit.  If so,
  367.         # it's a real literal.  We can only get away with
  368.         # doing the dot here because it is not a substring of
  369.         # any longer identifier.  If this gets changed, we'll
  370.         # have to move this code into do_operator().
  371.         #
  372.         last_token := do_dot(getchar)
  373.         suspend last_token
  374. #        write(&errout, "next_c == ", image(next_c))
  375.         next
  376.         }
  377.  
  378.         "\n"     : {
  379.         # If do_newline fails, it means we're at the end of
  380.         # the input stream, and we should break out of the
  381.         # repeat loop.
  382.         #
  383.         every last_token := do_newline(getchar, last_token, be_tbl)
  384.         do suspend last_token
  385.         if next_c === &null then break
  386.         next
  387.         }
  388.  
  389.         "\#"     : {
  390.         # Just a comment.  Strip it by reading every character
  391.         # up to the next newline.  The global var next_c
  392.         # should *always* == "\n" when this is done.
  393.         #
  394.         do_number_sign(getchar)
  395. #        write(&errout, "next_c == ", image(next_c))
  396.         next
  397.         }
  398.  
  399.         "\""    : {
  400.         # Suspend as STRINGLIT everything from here up to the
  401.         # next non-backslashed quotation mark, inclusive
  402.         # (accounting for the _ line-continuation convention).
  403.         #
  404.         last_token := do_quotation_mark(getchar)
  405.         suspend last_token
  406. #        write(&errout, "next_c == ", image(next_c))
  407.         next
  408.         }
  409.  
  410.         "'"     : {
  411.         # Suspend as CSETLIT everything from here up to the
  412.         # next non-backslashed apostrophe, inclusive.
  413.         #
  414.         last_token := do_apostrophe(getchar)
  415.         suspend last_token
  416. #        write(&errout, "next_c == ", image(next_c))
  417.         next
  418.         }
  419.  
  420.         &null   : stop("iparse_tokens (lexer):  unexpected EOF")
  421.  
  422.         default : {
  423.         # If we get to here, we have either whitespace, an
  424.         # integer or real literal, an identifier or reserved
  425.         # word (both get handled by do_identifier), or an
  426.         # operator.  The question of which we have can be
  427.         # determined by checking the first character.
  428.         #
  429.         if any(whitespace, next_c) then {
  430.             # Like all of the TOK forming procedures,
  431.             # do_whitespace resets next_c.
  432.             do_whitespace(getchar, whitespace)
  433.             # don't suspend any tokens
  434.             next
  435.         }
  436.         if any(&digits, next_c) then {
  437.             last_token := do_digits(getchar)
  438.             suspend last_token
  439.             next
  440.         }
  441.         if any(&letters ++ '_', next_c) then {
  442.             last_token := do_identifier(getchar, reserved_tbl)
  443.             suspend last_token
  444.             next
  445.         }
  446. #        write(&errout, "it's an operator")
  447.         last_token := do_operator(getchar, operators)
  448.         suspend last_token
  449.         next
  450.         }
  451.     }
  452.     }
  453.  
  454.     # If stream argument is nonnull, then we are in the top-level
  455.     # iparse_tokens().  If not, then we are in a recursive call, and
  456.     # we should not emit all this end-of-file crap.
  457.     #
  458.     if \stream then {
  459.     return TOK("EOFX")
  460.     }
  461.     else fail
  462.  
  463. end
  464.  
  465.  
  466. #
  467. #  do_dot:  coexpression -> TOK record
  468. #           getchar      -> t
  469. #
  470. #      Where getchar is the coexpression that produces the next
  471. #      character from the input stream and t is a token record whose
  472. #      sym field contains either "REALLIT" or "DOT".  Essentially,
  473. #      do_dot checks the next char on the input stream to see if it's
  474. #      an integer.  Since the preceding char was a dot, an integer
  475. #      tips us off that we have a real literal.  Otherwise, it's just
  476. #      a dot operator.  Note that do_dot resets next_c for the next
  477. #      cycle through the main case loop in the calling procedure.
  478. #
  479. procedure do_dot(getchar)
  480.  
  481.     local token
  482.     # global next_c
  483.  
  484. #    write(&errout, "it's a dot")
  485.  
  486.     # If dot's followed by a digit, then we have a real literal.
  487.     #
  488.     if any(&digits, next_c := @getchar) then {
  489. #    write(&errout, "dot -> it's a real literal")
  490.     token := "." || next_c
  491.     while any(&digits, next_c := @getchar) do
  492.         token ||:= next_c
  493.     if token ||:= (next_c == ("e"|"E")) then {
  494.         while (next_c := @getchar) == "0"
  495.         while any(&digits, next_c) do {
  496.         token ||:= next_c
  497.         next_c = @getchar
  498.         }
  499.     }
  500.     return TOK("REALLIT", token)
  501.     }
  502.  
  503.     # Dot not followed by an integer; so we just have a dot operator,
  504.     # and not a real literal.
  505.     #
  506. #    write(&errout, "dot -> just a plain dot")
  507.     return TOK("DOT", ".")
  508.     
  509. end
  510.  
  511.  
  512. #
  513. #  do_newline:  coexpression x TOK record x table -> TOK records
  514. #               (getchar, last_token, be_tbl)     -> Ts (a generator)
  515. #
  516. #      Where getchar is the coexpression that returns the next
  517. #      character from the input stream, last_token is the last TOK
  518. #      record suspended by the calling procedure, be_tbl is a table of
  519. #      tokens and their "beginner/ender" status, and Ts are TOK
  520. #      records.  Note that do_newline resets next_c.  Do_newline is a
  521. #      mess.  What it does is check the last token suspended by the
  522. #      calling procedure to see if it was a beginner or ender.  It
  523. #      then gets the next token by calling iparse_tokens again.  If
  524. #      the next token is a beginner and the last token is an ender,
  525. #      then we have to suspend a SEMICOL token.  In either event, both
  526. #      the last and next token are suspended.
  527. #
  528. procedure do_newline(getchar, last_token, be_tbl)
  529.  
  530.     local next_token
  531.     # global next_c
  532.  
  533. #    write(&errout, "it's a newline")
  534.  
  535.     # Go past any additional newlines.
  536.     #
  537.     while next_c == "\n" do {
  538.         # NL can be the last char in the getchar stream; if it *is*,
  539.     # then signal that it's time to break out of the repeat loop
  540.     # in the calling procedure.
  541.     #
  542.     next_c := @getchar | {
  543.         next_c := &null
  544.         fail
  545.     }
  546.     suspend TOK(&null, next_c == "\n")
  547.     }
  548.  
  549.     # If there was a last token (i.e. if a newline wasn't the first
  550.     # character of significance in the input stream), then check to
  551.     # see if it was an ender.  If so, then check to see if the next
  552.     # token is a beginner.  If so, then suspend a TOK("SEMICOL")
  553.     # record before suspending the next token.
  554.     #
  555.     if find("e", be_tbl[(\last_token).sym]) then {
  556. #    write(&errout, "calling iparse_tokens via do_newline")
  557. #    &trace := -1
  558.     # First arg to iparse_tokens can be null here.
  559.     \ (next_token := iparse_tokens(&null, getchar)).sym
  560.     if \next_token then {
  561. #        write(&errout, "call of iparse_tokens via do_newline yields ",
  562. #          ximage(next_token))
  563.         if find("b", be_tbl[next_token.sym])
  564.         then suspend TOK("SEMICOL", "\n")
  565.         #
  566.         # See below.  If this were like the real Icon parser,
  567.         # the following line would be commented out.
  568.         #
  569.         else suspend TOK(&null, "\n")
  570.         return next_token
  571.     }
  572.     else {
  573.         #
  574.         # If this were a *real* Icon tokenizer, it would not emit
  575.         # any record here, but would simply fail.  Instead, we'll
  576.         # emit a dummy record with a null sym field.
  577.         #
  578.         return TOK(&null, "\n")
  579. #           &trace := 0
  580. #        fail
  581.     }
  582.     }
  583.  
  584.     # See above.  Again, if this were like Icon's own tokenizer, we
  585.     # would just fail here, and not return any TOK record.
  586.     #
  587. #   &trace := 0
  588.     return TOK(&null, "\n")
  589. #   fail
  590.  
  591. end
  592.  
  593.  
  594. #
  595. #  do_number_sign:  coexpression -> &null
  596. #                   getchar      -> 
  597. #
  598. #      Where getchar is the coexpression that pops characters off the
  599. #      main input stream.  Sets the global variable next_c.  This
  600. #      procedure simply reads characters until it gets a newline, then
  601. #      returns with next_c == "\n".  Since the starting character was
  602. #      a number sign, this has the effect of stripping comments.
  603. #
  604. procedure do_number_sign(getchar)
  605.  
  606.     # global next_c
  607.  
  608. #    write(&errout, "it's a number sign")
  609.     while next_c ~== "\n" do {
  610.     next_c := @getchar
  611.     }
  612.  
  613.     # Return to calling procedure to cycle around again with the new
  614.     # next_c already set.  Next_c should always be "\n" at this point.
  615.     return
  616.  
  617. end
  618.  
  619.  
  620. #
  621. #  do_quotation_mark:  coexpression -> TOK record
  622. #                      getchar      -> t
  623. #
  624. #      Where getchar is the coexpression that yields another character
  625. #      from the input stream, and t is a TOK record with "STRINGLIT"
  626. #      as its sym field.  Puts everything upto and including the next
  627. #      non-backslashed quotation mark into the str field.  Handles the
  628. #      underscore continuation convention.
  629. #
  630. procedure do_quotation_mark(getchar)
  631.  
  632.     local token
  633.     # global next_c
  634.  
  635.     # write(&errout, "it's a string literal")
  636.     token := "\""
  637.     next_c := @getchar
  638.     repeat {
  639.     if next_c == "\n" & token[-1] == "_" then {
  640.         token := token[1:-1]
  641.         while any('\t ', next_c := @getchar)
  642.         next
  643.     } else {
  644.         if slshupto('"', token ||:= next_c, 2)
  645.         then {
  646.         next_c := @getchar
  647.         # resume outermost (repeat) loop in calling procedure,
  648.         # with the new (here explicitly set) next_c
  649.         return TOK("STRINGLIT", token)
  650.         }
  651.         next_c := @getchar
  652.     }
  653.     }
  654.  
  655. end
  656.  
  657.  
  658. #
  659. #  do_apostrophe:  coexpression -> TOK record
  660. #                  getchar      -> t
  661. #
  662. #      Where getchar is the coexpression that yields another character
  663. #      from the input stream, and t is a TOK record with "CSETLIT"
  664. #      as its sym field.  Puts everything upto and including the next
  665. #      non-backslashed apostrope into the str field.
  666. #
  667. procedure do_apostrophe(getchar)
  668.  
  669.     local token
  670.     # global next_c
  671.  
  672. #   write(&errout, "it's a cset literal")
  673.     token := "'"
  674.     next_c := @getchar
  675.     repeat {
  676.     if next_c == "\n" & token[-1] == "_" then {
  677.         token := token[1:-1]
  678.         while any('\t ', next_c := @getchar)
  679.         next
  680.     } else {
  681.         if slshupto("'", token ||:= next_c, 2)
  682.         then {
  683.         next_c := @getchar
  684.         # Return & resume outermost containing loop in calling
  685.         # procedure w/ new next_c.
  686.         return TOK("CSETLIT", token)
  687.         }
  688.         next_c := @getchar
  689.     }
  690.     }
  691.  
  692. end
  693.  
  694.  
  695. #
  696. #  do_digits:  coexpression -> TOK record
  697. #              getchar      -> t
  698. #
  699. #      Where getchar is the coexpression that produces the next char
  700. #      on the input stream, and where t is a TOK record containing
  701. #      either "REALLIT" or "INTLIT" in its sym field, and the text of
  702. #      the numeric literal in its str field.
  703. #
  704. procedure do_digits(getchar)
  705.  
  706.     local token, tok_record, extras, digits, over
  707.     # global next_c
  708.  
  709.     # For bases > 16
  710.     extras := "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"
  711.     # Assume integer literal until proven otherwise....
  712.     tok_record := TOK("INTLIT")
  713.  
  714. #   write(&errout, "it's an integer or real literal")
  715.     token := ("0" ~== next_c) | ""
  716.     while any(&digits, next_c := @getchar) do
  717.     token ||:= next_c
  718.     if token ||:= (next_c == ("R"|"r")) then {
  719.     digits := &digits
  720.     if over := ((10 < token[1:-1]) - 10) * 2 then
  721.         digits ++:= extras[1:over+1] | extras
  722.     next_c := @getchar
  723.     if next_c == "-" then {
  724.         token ||:= next_c
  725.         next_c := @getchar
  726.     }
  727.     while any(digits, next_c) do {
  728.         token ||:= next_c
  729.         next_c := @getchar
  730.     }
  731.     } else {
  732.     if token ||:= (next_c == ".") then {
  733.         while any(&digits, next_c := @getchar) do
  734.         token ||:= next_c
  735.         tok_record := TOK("REALLIT")
  736.     }
  737.     if token ||:= (next_c == ("e"|"E")) then {
  738.         next_c := @getchar
  739.         if next_c == "-" then {
  740.         token ||:= next_c
  741.         next_c := @getchar
  742.         }
  743.         while any(&digits, next_c) do {
  744.         token ||:= next_c
  745.         next_c := @getchar
  746.         }
  747.         tok_record := TOK("REALLIT")
  748.     }
  749.     }
  750.     tok_record.str := ("" ~== token) | "0"
  751.     return tok_record
  752.     
  753. end
  754.  
  755.  
  756. #
  757. #  do_whitespace:  coexpression x cset  -> &null
  758. #                  getchar x whitespace -> &null
  759. #
  760. #      Where getchar is the coexpression producing the next char on
  761. #      the input stream.  Do_whitespace just repeats until it finds a
  762. #      non-whitespace character, whitespace being defined as
  763. #      membership of a given character in the whitespace argument (a
  764. #      cset). 
  765. #
  766. procedure do_whitespace(getchar, whitespace)
  767.  
  768. #   write(&errout, "it's junk")
  769.     while any(whitespace, next_c) do
  770.     next_c := @getchar
  771.     return
  772.  
  773. end
  774.  
  775.  
  776. #
  777. #  do_identifier:  coexpression x table    -> TOK record
  778. #                  (getchar, reserved_tbl) -> t
  779. #
  780. #      Where getchar is the coexpression that pops off characters from
  781. #      the input stream, reserved_tbl is a table of reserved words
  782. #      (keys = the string values, values = the names qua symbols in
  783. #      the grammar), and t is a TOK record containing all subsequent
  784. #      letters, digits, or underscores after next_c (which must be a
  785. #      letter or underscore).  Note that next_c is global and gets
  786. #      reset by do_identifier.
  787. #
  788. procedure do_identifier(getchar, reserved_tbl)
  789.  
  790.     local token
  791.     # global next_c
  792.  
  793. #   write(&errout, "it's an indentifier")
  794.     token := next_c
  795.     while any(&letters ++ &digits ++ '_', next_c := @getchar)
  796.     do token ||:= next_c
  797.     return TOK(\reserved_tbl[token], token) | TOK("IDENT", token)
  798.     
  799. end
  800.  
  801.  
  802. #
  803. #  do_operator:  coexpression x list  -> TOK record
  804. #                (getchar, operators) -> t
  805. #
  806. #     Where getchar is the coexpression that produces the next
  807. #     character on the input stream, operators is the operator list,
  808. #     and where t is a TOK record describing the operator just
  809. #     scanned.  Calls recognop, which creates a DFSA to recognize
  810. #     valid Icon operators.  Arg2 (operators) is the list of lists
  811. #     containing valid Icon operator string values and names (see
  812. #     above).
  813. #
  814. procedure do_operator(getchar, operators)
  815.  
  816.     local token, elem
  817.  
  818.     token := next_c
  819.  
  820.     # Go until recognop fails.
  821.     while elem := recognop(operators, token, 1) do
  822.     token ||:= (next_c := @getchar)
  823. #   write(&errout, ximage(elem))
  824.     if *\elem = 1 then
  825.     return TOK(elem[1][2], elem[1][1])
  826.     else fail
  827.  
  828. end
  829.  
  830.  
  831. record dfstn_state(b, e, tbl)
  832. record start_state(b, e, tbl, master_list)
  833. #
  834. #  recognop: list x string x integer -> list
  835. #            (l, s, i)               -> l2
  836. #
  837. #     Where l is the list of lists created by the calling procedure
  838. #     (each element contains a token string value, name, and
  839. #     beginner/ender string), where s is a string possibly
  840. #     corresponding to a token in the list, where i is the position in
  841. #     the elements of l where the operator string values are recorded,
  842. #     and where l2 is a list of elements from l that contain operators
  843. #     for which string s is an exact match.  Fails if there are no
  844. #     operators that s is a prefix of, but returns an empty list if
  845. #     there just aren't any that happen to match exactly.
  846. #
  847. #      What this does is let the calling procedure just keep adding
  848. #      characters to s until recognop fails, then check the last list
  849. #      it returned to see if it is of length 1.  If it is, then it
  850. #      contains list with the vital stats for the operator last
  851. #      recognized.  If it is of length 0, then string s did not
  852. #      contain any recognizable operator.
  853. #
  854. procedure recognop(l, s, i)
  855.  
  856.     local   current_state, master_list, c, result, j
  857.     static  dfstn_table
  858.     initial dfstn_table := table()
  859.  
  860.     /i := 1
  861.     # See if we've created an automaton for l already.
  862.     /dfstn_table[l] := start_state(1, *l, &null, &null) & {
  863.     dfstn_table[l].master_list := sortf(l, i)
  864.     }
  865.  
  866.     current_state := dfstn_table[l]
  867.     # Save master_list, as current_state will change later on.
  868.     master_list   := current_state.master_list
  869.  
  870.     s ? {
  871.     while c := move(1) do {
  872.  
  873.         # Null means that this part of the automaton isn't
  874.         # complete.
  875.         #
  876.         if /current_state.tbl then
  877.         create_arcs(master_list, i, current_state, &pos)
  878.  
  879.         # If the table has been clobbered, then there are no arcs
  880.         # leading out of the current state.  Fail.
  881.         #
  882.         if current_state.tbl === 0 then
  883.         fail
  884.         
  885. #        write(&errout, "c = ", image(c))
  886. #        write(&errout, "table for current state = ", 
  887. #          ximage(current_state.tbl))
  888.  
  889.         # If we get to here, the current state has arcs leading
  890.         # out of it.  See if c is one of them.  If so, make the
  891.         # node to which arc c is connected the current state.
  892.         # Otherwise fail.
  893.         #
  894.         current_state := \current_state.tbl[c] | fail
  895.     }
  896.     }
  897.  
  898.     # Return possible completions.
  899.     #
  900.     result := list()
  901.     every j := current_state.b to current_state.e do {
  902.     if *master_list[j][i] = *s then
  903.         put(result, master_list[j])
  904.     }
  905.     # return empty list if nothing the right length is found
  906.     return result
  907.  
  908. end
  909.  
  910.  
  911. #
  912. #  create_arcs:  fill out a table of arcs leading out of the current
  913. #                state, and place that table in the tbl field for
  914. #                current_state
  915. #
  916. procedure create_arcs(master_list, field, current_state, POS)
  917.  
  918.     local elem, i, first_char, old_first_char
  919.  
  920.     current_state.tbl := table()
  921.     old_first_char := ""
  922.     
  923.     every elem := master_list[i := current_state.b to current_state.e][field]
  924.     do {
  925.     
  926.     # Get the first character for the current position (note that
  927.     # we're one character behind the calling routine; hence
  928.     # POS-1).
  929.     #
  930.     first_char := elem[POS-1] | next
  931.     
  932.     # If we have a new first character, create a new arc out of
  933.     # the current state.
  934.     #
  935.     if first_char ~== old_first_char then {
  936.         # Store the start position for the current character.
  937.         current_state.tbl[first_char] := dfstn_state(i)
  938.         # Store the end position for the old character.
  939.         (\current_state.tbl[old_first_char]).e := i-1
  940.         old_first_char := first_char
  941.     }
  942.     }
  943.     (\current_state.tbl[old_first_char]).e := i
  944.  
  945.     # Clobber table with 0 if no arcs were added.
  946.     current_state.tbl := (*current_state.tbl = 0)
  947.     return current_state
  948.  
  949. end
  950. -- 
  951.  
  952.    -Richard L. Goerwitz              goer%midway@uchicago.bitnet
  953.    goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer
  954.